home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / sorstp.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  5.7 KB  |  206 lines
  1. /* sorstp.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  12.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  13.          pivrel;
  14. } knstnt_;
  15.  
  16. #define knstnt_1 knstnt_
  17.  
  18. struct {
  19.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  20.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  21. } cirdat_;
  22.  
  23. #define cirdat_1 cirdat_
  24.  
  25. struct {
  26.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  27.         sfactr;
  28.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  29.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  30. } status_;
  31.  
  32. #define status_1 status_
  33.  
  34. struct {
  35.     doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas, 
  36.         rstats[50];
  37.     integer iwidth, lwidth, nopage;
  38. } miscel_;
  39.  
  40. #define miscel_1 miscel_
  41.  
  42. struct {
  43.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  44.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  45. } flags_;
  46.  
  47. #define flags_1 flags_
  48.  
  49. struct {
  50.     doublereal value[200000];
  51. } blank_;
  52.  
  53. #define blank_1 blank_
  54.  
  55. /*<       subroutine sorstp(itlim) >*/
  56. /* Subroutine */ int sorstp_(itlim)
  57. integer *itlim;
  58. {
  59.     /* Format strings */
  60.     static char fmt_110[] = "(\0020 source stepping method failed\002)";
  61.  
  62.     /* Builtin functions */
  63.     double sqrt();
  64.     integer s_wsfe(), e_wsfe();
  65.  
  66.     /* Local variables */
  67.     extern /* Subroutine */ int iter8_();
  68.     static doublereal bound, fractn;
  69. #define nodplc ((integer *)&blank_1)
  70. #define cvalue ((complex *)&blank_1)
  71.  
  72.     /* Fortran I/O blocks */
  73.     static cilist io__5 = { 0, 0, 0, fmt_110, 0 };
  74.  
  75.  
  76. /*<       implicit double precision (a-h,o-z) >*/
  77.  
  78. /*     this routine uses the source stepping method to solve the dc */
  79. /*     operating point */
  80.  
  81. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  82. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  83. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  84. /*<      2   pivtol,pivrel >*/
  85. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  86. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  87. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  88. /* spice version 2g.6  sccsid=status 3/15/83 */
  89. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  90. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  91. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  92. /* spice version 2g.6  sccsid=miscel 3/15/83 */
  93. /*<       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
  94. /*<      1  defas,rstats(50),iwidth,lwidth,nopage >*/
  95. /* spice version 2g.6  sccsid=flags 3/15/83 */
  96. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  97. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  98. /* spice version 2g.6  sccsid=blank 3/15/83 */
  99. /*<       common /blank/ value(200000) >*/
  100. /*<       integer nodplc(64) >*/
  101. /*<       complex cvalue(32) >*/
  102. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  103.  
  104. /*<       bound=1.0d0/64 >*/
  105.     bound = .015625;
  106. /*<       fractn=1.0d0/16 >*/
  107.     fractn = .0625;
  108.  
  109. /*  step down sources */
  110.  
  111. /*<    10 fractn=fractn*2.0d0 >*/
  112. L10:
  113.     fractn *= 2.;
  114. /*<       sfactr=sfactr*fractn >*/
  115.     status_1.sfactr *= fractn;
  116. /*<       if (sfactr.lt.bound) go to 100 >*/
  117.     if (status_1.sfactr < bound) {
  118.     goto L100;
  119.     }
  120. /*<       initf=2 >*/
  121.     status_1.initf = 2;
  122. /*<       call iter8(itlim) >*/
  123.     iter8_(itlim);
  124. /*<       rstats(6)=rstats(6)+iterno >*/
  125.     miscel_1.rstats[5] += status_1.iterno;
  126. /*<       if (igoof.ne.0) go to 10 >*/
  127.     if (flags_1.igoof != 0) {
  128.     goto L10;
  129.     }
  130. /*<       fractn=2.0d0 >*/
  131.     fractn = 2.;
  132.  
  133. /*  step up sources */
  134.  
  135. /*<    20 sfactr=sfactr*fractn >*/
  136. L20:
  137.     status_1.sfactr *= fractn;
  138. /*<       if (sfactr.le.1.0d0) go to 30 >*/
  139.     if (status_1.sfactr <= 1.) {
  140.     goto L30;
  141.     }
  142. /*<       sfactr=1.0d0 >*/
  143.     status_1.sfactr = 1.;
  144. /*<    30 initf=3 >*/
  145. L30:
  146.     status_1.initf = 3;
  147. /*<       call iter8(itlim) >*/
  148.     iter8_(itlim);
  149. /*<       rstats(6)=rstats(6)+iterno >*/
  150.     miscel_1.rstats[5] += status_1.iterno;
  151. /*<       if ((igoof.eq.0).and.(sfactr.eq.1.0d0)) go to 200 >*/
  152.     if (flags_1.igoof == 0 && status_1.sfactr == 1.) {
  153.     goto L200;
  154.     }
  155. /*<       if (igoof.eq.0) go to 20 >*/
  156.     if (flags_1.igoof == 0) {
  157.     goto L20;
  158.     }
  159.  
  160. /*  step down if step up failed */
  161.  
  162. /*<    40 fractn=dsqrt(fractn) >*/
  163. L40:
  164.     fractn = sqrt(fractn);
  165. /*<       if (fractn.lt.1.0001d0) go to 100 >*/
  166.     if (fractn < 1.0001) {
  167.     goto L100;
  168.     }
  169. /*<       sfactr=sfactr/fractn >*/
  170.     status_1.sfactr /= fractn;
  171. /*<       initf=3 >*/
  172.     status_1.initf = 3;
  173. /*<       call iter8(itlim) >*/
  174.     iter8_(itlim);
  175. /*<       rstats(6)=rstats(6)+iterno >*/
  176.     miscel_1.rstats[5] += status_1.iterno;
  177. /*<       if (igoof.ne.0) go to 40 >*/
  178.     if (flags_1.igoof != 0) {
  179.     goto L40;
  180.     }
  181. /*<       go to 20 >*/
  182.     goto L20;
  183.  
  184. /*   finish with source stepping method */
  185.  
  186. /*<   100 igoof=1 >*/
  187. L100:
  188.     flags_1.igoof = 1;
  189. /*<       write(iofile,110) >*/
  190.     io__5.ciunit = status_1.iofile;
  191.     s_wsfe(&io__5);
  192.     e_wsfe();
  193. /*<   110 format('0 source stepping method failed') >*/
  194. /*<   200 initf=2 >*/
  195. L200:
  196.     status_1.initf = 2;
  197. /*<       return >*/
  198.     return 0;
  199. /*<       end >*/
  200. } /* sorstp_ */
  201.  
  202. #undef cvalue
  203. #undef nodplc
  204.  
  205.  
  206.